perm filename PLOT.SAI[X,ALS]1 blob sn#066750 filedate 1973-10-12 generic text, type T, neo UTF8
00010	BEGIN "PLOT"
00020	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030	DEFINE ⊃="⊂";
00040	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00050	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00060	⊂ REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00070	⊂ REQUIRE "INSERT[X,ALS]" LOAD_MODULE;
00080	LABEL STARTP,STOPP;
00090	DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00100	REQUIRE "LPC1[X,ALS]" LOAD_MODULE;
00110	FORTRAN REAL PROCEDURE SQRT(REAL X);
00120	FORTRAN REAL PROCEDURE ALOG10(REAL X);
00130	FORTRAN REAL PROCEDURE COS(REAL X);
00140	FORTRAN REAL PROCEDURE SIN(REAL X);
00150	INTEGER ZEROC,ZEROF,DX;
00160	EXTERNAL FORTRAN PROCEDURE LPC1(REFERENCE REAL IFFY;
00170	  REFERENCE INTEGER MPTS;REFERENCE REAL CF;REFERENCE INTEGER M;
00180	  REFERENCE REAL R0,ERRN,ERR,SPT;REFERENCE INTEGER NSP,ISSW);
00190	REQUIRE "F[X,ALS]" LOAD_MODULE;
00200	EXTERNAL FORTRAN PROCEDURE FRXFM(REFERENCE INTEGER M;REFERENCE REAL X,Y);
00210	\ REAL ARRAY A,B,C,D[0:512];
00220	REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00230	INTERNAL REAL R0;
00240	INTEGER LPCOPT;
00250	INTEGER ARRAY DPYBUF[0:4095];
00260	INTEGER ARRAY LFILE[0:'177];
00270	INTEGER ARRAY SYMBOL[0:127];
00280	INTEGER ARRAY DAT,AVDAT[0:23];
00290	STRING ARRAY SAMPLE[0:127];
00300	INTEGER I,J,K,L,M,N,P,PP,Q,R,POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00310	INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,PTCNT,PICK,OPT,SHUFCT;
00320	INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,READ3,SEGTOT,SEGIN,IIT,JJT,KKT,NNT,SEGCT;
00330	BOOLEAN ER;
00340	INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00350	INTEGER ARRAY BUF,BUFT[0:511];
00360	STRING FILEN,READ,READ1,FILEO,READ2,FILEQ,TFILE,FILLST;
00370	
00380	PROCEDURE OUTALL(STRING S);
00390	BEGIN
00400	STRING SS; INTEGER J;
00410	SETBREAK(18,0,NULL,"OSN");
00420	SS←SCAN(S,18,J);
00430	OUTSTR(SS);
00440	END;
00450	
00460	PROCEDURE DATAIN;
00470	BEGIN
00480	INTEGER J;
00490	  FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00500	  IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512)
00510	  ELSE OUTSTR("No more data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00520	  POINTX←POINT(12,BUF[0],-1);
00530	SEGC←II←II+12; JJ←II+11;
00540	END;
00550	
00560	PROCEDURE DATTIN;
00570	BEGIN
00580	INTEGER J;
00590	  FOR J←0 STEP 1 UNTIL 511 DO BUFT[J]←0;
00600	  IF EOFA=0 THEN ARRYIN(CHAN2,BUFT[0],512)
00610	  ELSE OUTSTR("No more T0X data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00620	  POINTT←POINT(6,BUFT[0],-1);
00630	SEGCT←IIT←IIT+128; JJT←IIT+127;
00640	END;
00650	
00660	
00670	PROCEDURE PLOT;
00680	BEGIN
00690	INTEGER I,JP,K,LP;
00700	PTCNT←PTCNT+1; IF PTCNT≤4 THEN BEGIN
00710	POINTV←POINTX;
00720	⊂ RVECT(128,0); ⊂ RIVECT(-128,0);	⊂ Draw axis;
00730	K←LDB(POINTV); IF K>2047 THEN K←K-4096;
00745	    K←K%8;
00750	
00760	RIVECT(0,K);
00770	FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00780	  JP←ILDB(POINTV); IF JP>2047 THEN JP←JP-4096;
00781	    D[DX]←JP; DX←DX+1;
00782	⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(JP)&CRLF);
00785	  JP←JP%8;
00790	  LP←JP-K; RVECT(1,LP); K←JP; END;
00800	RIVECT(0,-K);
00810	IF PTCNT=4 THEN BEGIN
00820	  RIVECT(-200,-130);
00830	  READ←CVSTR(SYMBOL[Q])[1 TO 1];
00840	  DPYSST(CVXSTR(LFILE[10])[2 TO 3]&"  "&READ&" "&CVS(J)&" "&CVS(KK));
00850	  RIVECT(60,130); END;
00860	END;END;
00870	
00880	PROCEDURE FRIC;
00890	BEGIN
00900	INTEGER JJJ;
00910	⊂ STATE=0 means on way up
00920	  STATE=1 means on way down;
00930	  M←0;
00940	 PLOT;
00950	  FOR JJJ←0 STEP 1 UNTIL 127 DO BEGIN
00960	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00970	    IF STATE=0 THEN BEGIN
00980	     IF VAL<K-DELTA THEN BEGIN
00990	      M←M+(K-VAL); STATE←-1; END; END ELSE
01000	     IF VAL>K+DELTA THEN  BEGIN
01010	      M←M+(VAL-K); STATE←0; END;
01020	    K←VAL;
01030	    IF JJJ=0 THEN M←0;
01040	    END;
01050	M←M%100; IF M>63 THEN M←63;
01060	SEGC←SEGC+1;
01070	END;
01080	
01090	PROCEDURE DATA;
01100	BEGIN
01110	INTEGER I;
01120	FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01130	  DAT[I]←ILDB(POINTT);
01140	  AVDAT[I]←AVDAT[I]+DAT[I];
01150	  END;
01160	SEGCT←SEGCT+1;
01170	END;
01180	
01190	PROCEDURE TYDATT;
01200	BEGIN
01210	INTEGER I,J,K;
01220	K←0; 
01230	FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01240	  J←ILDB(POINTT);
01250	OUTALL(CVS(J));
01260	END; OUTSTR(CRLF);  END;
01270	
01280	PROCEDURE SKIP;
01290	BEGIN
01300	INTEGER JJJ;
01310	 FOR JJJ←0 STEP 1 UNTIL 127 DO IBP(POINTX);
01320	K←LDB(POINTX); IF K>2047 THEN K←K-4096;
01330	SEGC←SEGC+1;
01340	⊃ OUTSTR("Skip to segc= "&CVS(SEGC)&CRLF);
01350	END;
01360	
01370	PROCEDURE SKIPT;
01380	BEGIN
01390	INTEGER JJJ;
01400	 FOR JJJ←0 STEP 1 UNTIL 23 DO IBP(POINTT);
01410	SEGCT←SEGCT+1;
01420	⊃ OUTSTR("Skip to segct= "&CVS(SEGCT)&CRLF);
01430	END;
01440	
01450	PROCEDURE SHUFFLE;
01460	BEGIN "SHUF"
01470	INTEGER I,J,K;
01480	
01490	AIVECT(-640,-365);
01500	I←DPYPTR-PT1; ⊂ Words to save;
01510	J←PT1-PT0; ⊂ Words to overwrite;
01520	⊂ OUTSTR("PT0= "&CVS(PT0)&TB&"PT1= "&CVS(PT1)&TB&"DPYPTR= "&CVS(DPYPTR)&TB);
01530	⊂  OUTSTR("I= "&CVS(I)&TB&"J= "&CVS(J)&CRLF); ⊂  INCHWL;
01540	FOR K←1 STEP 1 UNTIL I DO DPYBUF[K+3]←DPYBUF[K+3+J];
01550	FOR K←I+1 STEP 1 UNTIL J+I DO DPYBUF[K+3]←1;
01560	PT1←DPYPTR←PT0+I;
01570	⊂ PTOCHW(0,'10103); DPYOUT(0); PTOCHW(0,'10120);
01580	END "SHUF";
01590	
01600	PROCEDURE RARDIS;
01610	BEGIN
01620	INTEGER I,J,K,SP;
01630	INTEGER LY,DY;
01640	REAL MAX,MIN;
01650	
01660	MAX←-1000.;MIN←10000.;
01670	FOR I←0 STEP 1 UNTIL N%2 DO BEGIN
01680	  IF C[I]>MAX THEN MAX←C[I]; IF C[I]≤MIN THEN MIN←C[I]; END;
01690	IF MIN>0 THEN MIN←0.; MAX←(MAX-MIN)/256;
01700	SP←2;  COMMENT HORIZONTAL SPACING;
01710	FOR I←0 STEP 1 UNTIL N%2-1 DO C[I]←(C[I]-MIN)/MAX;
01720	LY←C[0]; RVECT(0,LY-128);
01730	FOR I←0 STEP 1 UNTIL N%2 DO
01740	BEGIN
01750		DY←C[I]-LY;
01760		LY←LY+DY;
01770		RVECT(SP,DY);
01780	END;
01790	RIVECT(0,128-LY);
01800	END "RARDIS";
01810	
01820	INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
01830	BEGIN
01840	COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES  THE SINGLE VARIATE
01850	COMPLEX TRANSFORM ;
01860	INTEGER K,NK,NH;
01870	REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
01880	NH←N%2;  R←3.1415926536/N;
01890	DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
01900	DC←-0.5*R; CK←1.0;  SK←0;
01910	IF EVALUATE THEN
01920	BEGIN
01930	CK←-1.0; DC←-DC;
01940	END
01950	ELSE
01960	BEGIN
01970	A[N]←A[0]; B[N]←B[0];
01980	END;
01990	FOR K←0 STEP 1 UNTIL NH DO
02000	BEGIN
02010		NK←N-K;
02020		AA←A[K]+A[NK]; AB←A[K]-A[NK];
02030		BA←B[K]+B[NK]; BB←B[K]-B[NK];
02040		RE←CK*BA+SK*AB;  IM←SK*BA-CK*AB;
02050		B[NK]←IM-BB; B[K]←IM+BB;
02060		A[NK]←AA-RE; A[K]←AA+RE;
02070		DC←R*CK+DC; CK←CK+DC;
02080		DS←R*SK+DS; SK←SK+DS;
02090	END;
02100	END "XRTRAN";
02110	
02120	INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
02130	BEGIN "FORM"
02140	REAL ERRN,ERR;
02150	INTEGER I,J;
02160	 M←9; N←2↑M; DEFINE PI="3.141592653";
02170	IF WINDOW[N%2]=0 THEN
02180	  FOR I←0 STEP 1 UNTIL N DO  WINDOW[I]←(1-COS((2*PI*I)/N))/2;
02185	FOR I←0 STEP 1 UNTIL N DO A[I]←D[I];
02190	IF LPCOPT=0 THEN BEGIN "LPC"
02210	 FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
02220	 ⊂  LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
02230	I←24; J←N%2; LPC1(A[0],N,B[0],I,R0,ERRN,ERR,C[0],J,1);
02240	END "LPC" ELSE BEGIN "FFT"
02250	FOR I←0 STEP 1 UNTIL N DO BEGIN
02260	  A[I]←D[I]*WINDOW[I]; B[I]←0;
02265	⊃ SETFORMAT(10,3); ⊃  OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
02270	END;  I←24; J←N%2;
02280	FRXFM(M,A[0],B[0]);
02290	⊃ OUTSTR("FFT COMPLETE"&CRLF);
02300	FOR I←0 STEP 1 UNTIL N%2 DO BEGIN
02310	  X←A[I]↑2+B[I]↑2+1.*10↑-37;
02315	⊃ OUTSTR(CVG(A[I])&"  "&CVG(B[I])&"  "&CVG(X)&TB);
02320	  C[I]←5.*ALOG10(X); END;
02330	END "FFT";	
02340	RARDIS;
02350	END "FORM";
     

00010	TYPLOC(512,50);
00020	DPYSET(DPYBUF); AIVECT(-640,-90); PT0←DPYPTR; 
00030	SHUFCT←0;AIVECT(-640,-365);PT1←DPYPTR;
00040	FILEN←"HI20.001[CMP,JH]";
00050	FILEO←"SEG1.FRI";
00060	⊂ HEADIN;
00070	STDBRK(1);
00080	 SETBREAK(14,"∃",NULL,"INS");
00090	 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00100	 SETBREAK(16,'56,NULL,"INA");
00110	 SETBREAK(17,'12,'15,"INS");
00120	
00130	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00140	OUTSTR("This program will show header information and wave forms for"
00150	  &CRLF&" a selected phonette. After every display it waits for a "
00160	  &crlf&" command. A space bar causes it to continue, a letter S causes it "
00170	  &CRLF&"start over by asking for a phonette, while an E exits."&CRLF);
00180	OUTSTR("At present this program takes acoustic data from [CMP,JH]"&
00190	   CRLF&" and header information from files .T0X[11,ALS]."&CRLF&LF);
00200	
00210	CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00220	LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00230	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS].  File = ");
00240	LOOKUP(CHAN4,TFILE←INCHWL,ER); END;  EOFA←0;
00250	FILLST←INPUT(CHAN4,14);
00260	⊂ OUTSTR("MAP.PHN contains "&CRLF&FILLST&CRLF);
00270	CLOSE(CHAN4);
00280	
00290	FOR I←0 STEP 1 UNTIL 127 DO  BEGIN
00300	  WHILE TRUE DO BEGIN
00310	    READ1←SCAN(FILLST,17,K);
00320	    READ3←READ1[1 TO 1];
00330	    IF READ3≠"⊂"  THEN DONE; END;
00340	IF READ3="" THEN DONE;
00350	  SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00360	  SAMPLE[I]←READ1; END;
00370	
00380	STARTP:
00390	WHILE TRUE DO BEGIN "PICK"
00400	  OUTSTR("Type PH to select (CR for everything) ");
00410	  IF (READ←INCHWL)="" THEN DONE ELSE BEGIN PICK←CVASC(READ);
00420	⊂ OUTALL(CVSTR(PICK)&TB&CVOS(PICK)&TB&TB&CVSTR(SYMBOL[0])&TB&CVOS(SYMBOL[0])&CRLF);
00430	    FOR Q←0 STEP 1 UNTIL 127 DO IF PICK=SYMBOL[Q] THEN DONE;
00440	    IF Q<128 THEN DONE;
00450	    OUTSTR("Not found"&crlf); END; END "PICK";
00460	OUTSTR(CRLF&"You have selected "&tb);
00470	IF READ="" THEN BEGIN OPT←0; OUTSTR("Everything"&crlf); END ELSE BEGIN
00480	  OUTALL(CVSTR(PICK)&TB&SAMPLE[Q]&CRLF&" "); OPT←1; END;
00490	DELTA←15;
00500	⊂ OUTSTR("Specify DELTA (CR for 15) ");
00510	⊂ IF (READ←INCHWL)="" THEN DELTA←15 ELSE DELTA←CVD(READ);
00520	
00530	FOR PP←1 STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00540	  CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00550	SETFORMAT(-3,0); FILEQ←CVS(PP);
00560	  FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,JH]";
00570	LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00580	WHILE ER DO BEGIN
00590	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00600	   LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00610	J←K←L←STATE←VAL←R←0;
00620	SETFORMAT(1,0);  FILEQ←CVS(PP);
00630	
00640	READ←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00650	CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00660	LOOKUP(CHAN2,READ,ER); TFILE←READ;
00670	WHILE ER DO BEGIN
00680	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00690	   LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00700	ARRYIN(CHAN2,LFILE[0],'200);	⊂ Input header;
00710	SEGTOT←(LFILE[0]*6)%256;
00720	⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&"   ");
00730	
00740	READ2←READ;
00750	READ1←SCAN(READ2,16,J)&"DOC";
00760	⊃ OUTSTR("Ready to write "&READ1&TB);
00770	⊂ OUTSTR(CRLF&"  ");
00780	⊂   FOR I←10 STEP 1 UNTIL 20 DO OUTSTR(CVXSTR(LFILE[I]));
00790	⊂ OUTSTR(CRLF);
00800	⊂ OUTSTR("First"&TB&"Average"&TB&"Last"&TB
00810	   &"Symbol"&TB&"Start"&TB&"Length"&TB&"Sample"&TB&"Features"&CRLF);
00820	
00830	II←-11; JJ←-1; IIT←-127; JJT←-1; SETFORMAT(3,0); SEGIN←0;
00840	FOR I←21 STEP 1 UNTIL 127 DO BEGIN
00850	  IF LFILE[I]=0 THEN IF I>0 THEN DONE ELSE BEGIN OUTSTR("No data."&crlf);
00860	    done end;
00870	  L←LFILE[I] LAND '777760000000;
00880	 IF (OPT=0) ∨ (L=PICK) THEN BEGIN "SELECT"
00890	  IF SHUFCT=0 THEN BEGIN
00900	OUTSTR(CR&"   F1    F3    A2    FP1   FP2   FZ    NP    NZ    LPE   HPE   HPA   PIT"
00910	 &CRLF&"      F2    A1    A3    FP1A  FP2A  FZA   NPA   NZA   AVE   LPA   FRI   FRI4"
00920	&CRLF); END;
00930	
00940	  FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
00950	  J←LDB(POINT(14,LFILE[I],27)); KK←LDB(POINT(8,LFILE[I],35));
00960	
00970	IF KK<4 THEN PTCNT←4-KK;
00980	IF KK≤0 THEN OUTSTR(TB&TB&TB) ELSE BEGIN
00990	  IF II>J THEN BEGIN
01000	    OUTSTR("Out of step with SEGC= "&CVS(SEGC)&", J= "&CVS(J)&" and II= "&
01010	     CVS(II)&CRLF);
01020	    INCHWL; END;
01030	  IF IIT>J THEN BEGIN
01040	    OUTSTR("Out of step with SEGCT= "&CVS(SEGCT)&", J= "&CVS(J)&" and IIT= "&
01050	     CVS(IIT)&", JJT= "&CVS(JJT)&CRLF);
01060	    INCHWL; END;
01070	
01080	WHILE JJ<J DO DATAIN; WHILE JJT<J DO DATTIN;
01090	WHILE SEGC<J DO SKIP; WHILE SEGCT<J DO SKIPT;
01100	
01110	FOR DX←0 STEP 1 UNTIL 512 DO D[DX]←0; DX←0;
01120	FRIC;
01130	FOR K←0 STEP 1 UNTIL 23 DO AVDAT[K]←0;
01140	DATA; DAT[23]←M;
01150	
01160	OUTSTR("F ");
01170	FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01180	⊂ IF M>0 THEN OUTSTR(CVS(M)&TB) ELSE OUTSTR("  "&TB);
01190	N←M;
01200	
01210	FOR R←2 STEP 1 UNTIL KK DO BEGIN
01220	  IF SEGC>JJ THEN DATAIN;
01230	  IF SEGCT>JJT THEN DATTIN;
01240	  FRIC; N←N+M; DATA; END;
01250	DAT[23]←M; AVDAT[23]←N;
01260	⊂ IF N>0 THEN OUTSTR(CVS(N)&TB) ELSE OUTSTR("  "&TB);
01270	⊂ IF M>0 THEN OUTSTR(CVS(M)&TB) ELSE OUTSTR("  "&TB);
01280	OUTSTR("A ");
01290	FOR K←0 STEP 1 UNTIL 23 DO BEGIN
01300	  AVDAT[K]←AVDAT[K]%KK; OUTSTR(CVS(AVDAT[K])); END; OUTSTR(CRLF);
01310	OUTSTR("L ");
01320	FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01330	END;
01340	
01350	⊂   OUTALL(CVSTR(L)&TB&CVS(J)&TB&CVS(KK)&CRLF);
01360	⊂ TYDATT;
01370	DPYOUT(0);PTOCHW(0,'10120); PTCNT←0;
01380	
01390	OUTSTR("space bar to continue, F for FFT, L for LPC, B for both, "&
01400	   "S to start, E to exit."&crlf);
01410	READ1←INCHRW; OUTSTR(CR);
01420	SHUFCT←SHUFCT+1; IF SHUFCT<2 THEN BEGIN OUTSTR(LF); RIVECT(40,0); END
01430	ELSE BEGIN CLRBUF;  SHUFCT←0; SHUFFLE; END;
01440	IF (READ1="F")∨(READ1="L")∨(READ1="B") THEN BEGIN
01450	IF (READ1="F")∨(READ1="B") THEN FORM(1);
01460	IF READ1="B" THEN RIVECT(-256,0);
01470	IF (READ1="L")∨(READ1="B") THEN FORM(0);
01480	DPYOUT(0); PTOCHW(0,'10120);
01490	OUTSTR(CRLF&"space bar to continue, S to start over, E to exit."&crlf);
01500	READ1←INCHRW; OUTSTR(CR);
01510	SHUFCT←SHUFCT+1; IF SHUFCT<2 THEN RIVECT(40,0)
01520	ELSE BEGIN CLRBUF;SHUFCT←0; SHUFFLE; END;
01530	END;
01540	  IF (READ1="S")∨(READ1="s") THEN BEGIN
01550	    OUTSTR(LF&"You are starting over"&CRLF);
01560	    GOTO STARTP; END;
01570	  IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
01580	END "SELECT";
01590	 END;
01600	
01610	END "FILEREAD";
01620	OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
01630	STOPP:
01640	END "PLOT";